package STDF_inline_C;
use utf8;
use Moo;
use warnings;
use 5.24.0;
use feature ':5.24';
use experimental qw(lexical_subs signatures smartmatch);
use Time::localtime;
use Carp qw(carp croak confess);
use Scalar::Util qw(reftype);
use PerlIO::via::gzip;
use POSIX ();
use STDF_Array;
use Inline C => Config => ccflagsex => "-x c -std=c99 -O2";
use Inline C =>  << '_C_CODE_';

#define PTR_HEADER1_LEN 13
#define CHAR_LEN 1
#define PARAM_INFO_BLOCK_LEN 13
#define PARAM_SPEC_LEN 8

struct PTR_Header_1 {
    unsigned int TEST_NUM;
    unsigned char HEAD_NUM;
    unsigned char SITE_NUM;
    unsigned char TEST_FLG;
    unsigned char PARM_FLG;
    float RESULT;
    unsigned char TEST_TXT_LEN;
    char TEST_TXT[255];
};

struct PTR_PARAM_INFO {
    unsigned char OPT_FLAG;
    char RES_SCAL;
    char LLM_SCAL;
    char HLM_SCAL;
    float LO_LIMIT;
    float HI_LIMIT;
    unsigned char UNITS_LEN;
    char UNITS[255];
};

struct REC_Cn {
    unsigned char TEXT_LEN;
    char TEXT[255];
};

char* fmt_key_list[] = {
        "C_RESFMT",
        "C_LLMFMT",
        "C_HLMFMT"
    };

int fetch_and_store_a_str( HV* ptr_hash, const char* key, U32 klen, char* rec_body_point, SSize_t body_len ){
    struct REC_Cn* ptr_alarm_id = ( struct REC_Cn* )rec_body_point;
    // char key_format[255];
    // char key_loc[255];
    // sprintf( key_format, "%%.%ds", klen );

    // sprintf( key_loc, key_format, key );

    if( klen > 36 ){
        croak( "key len is larger than 36 byte when fetch a C*n key-value." );
    }
    if( ptr_alarm_id->TEXT_LEN == 0 ){
        hv_store( ptr_hash, key, klen, newSVpvn( "", 0 ), 0 );
    }else if( body_len >= CHAR_LEN + ptr_alarm_id->TEXT_LEN ){
        hv_store( ptr_hash, key, klen, newSVpvn( ptr_alarm_id-> TEXT, ptr_alarm_id-> TEXT_LEN ), 0 );
    }else{
        char format_str[255];
        char error_str[255];
        sprintf( format_str, "no enought bytes for %%.%ds.", klen );
        sprintf( error_str, format_str, key );
        croak( error_str );
    }

    return( CHAR_LEN + ptr_alarm_id-> TEXT_LEN );
}

SV* handle_ptr_c( SV* rec_body ){
    // return result as a hash ref.
    HV* ptr_hash = newHV();

    // body_len is the total byte length of REC_BODY.
    // If its size is smaller than the minimal necssary, func will croak.
    SSize_t body_len = SvCUR( rec_body );
    if( body_len < PTR_HEADER1_LEN ){
        croak("PTR Body Len is too short, even no enought bytes for minimal information.");
    }
    char* rec_body_point = SvPVX( rec_body );

    // Using structure to parsing data directly.
    struct PTR_Header_1* ptr_header_1 = ( struct PTR_Header_1* )rec_body_point;
    hv_store( ptr_hash, "TEST_NUM",      8, newSVuv( ptr_header_1-> TEST_NUM     ), 0 );
    hv_store( ptr_hash, "HEAD_NUM",      8, newSVuv( ptr_header_1-> HEAD_NUM     ), 0 );
    hv_store( ptr_hash, "SITE_NUM",      8, newSVuv( ptr_header_1-> SITE_NUM     ), 0 );
    hv_store( ptr_hash, "TEST_FLG",      8, newSVuv( ptr_header_1-> TEST_FLG     ), 0 );
    hv_store( ptr_hash, "PARM_FLG",      8, newSVuv( ptr_header_1-> PARM_FLG     ), 0 );
    hv_store( ptr_hash, "RESULT",        6, newSVnv( ptr_header_1-> RESULT       ), 0 );
    hv_store( ptr_hash, "TEST_TXT_LEN", 12, newSVuv( ptr_header_1-> TEST_TXT_LEN ), 0 );
    
    if( body_len - PTR_HEADER1_LEN < ptr_header_1-> TEST_TXT_LEN ){
        croak( "No enought bytes for TEST_TXT parsing." );
    }else if( ptr_header_1-> TEST_TXT_LEN > 0 ){
        hv_store( ptr_hash, "TEST_TXT", 8, newSVpv( ptr_header_1-> TEST_TXT, ptr_header_1-> TEST_TXT_LEN ), 0 );
    }else{
        // C*n means "first byte is the length of followed char array."
        hv_store( ptr_hash, "TEST_TXT", 8, newSVpv( "", 0 ), 0 );
    }

    SSize_t header_1_len = PTR_HEADER1_LEN + ptr_header_1-> TEST_TXT_LEN;
    rec_body_point += header_1_len;
    body_len -= header_1_len;

    if( body_len >= CHAR_LEN ){
        int alaram_len = fetch_and_store_a_str( ptr_hash, "ALARM_ID", 8, rec_body_point, body_len );
        body_len -= alaram_len;
        rec_body_point += alaram_len;
    }else{
        body_len = 0;
    }

    if( body_len >= PARAM_INFO_BLOCK_LEN ){
        struct PTR_PARAM_INFO* param_info = ( struct PTR_PARAM_INFO* )rec_body_point;
        hv_store( ptr_hash, "OPT_FLAG",  8, newSVuv( param_info-> OPT_FLAG  ), 0 );
        hv_store( ptr_hash, "RES_SCAL",  8, newSViv( param_info-> RES_SCAL  ), 0 );
        hv_store( ptr_hash, "LLM_SCAL",  8, newSViv( param_info-> LLM_SCAL  ), 0 );
        hv_store( ptr_hash, "HLM_SCAL",  8, newSViv( param_info-> HLM_SCAL  ), 0 );
        hv_store( ptr_hash, "LO_LIMIT",  8, newSVnv( param_info-> LO_LIMIT  ), 0 );
        hv_store( ptr_hash, "HI_LIMIT",  8, newSVnv( param_info-> HI_LIMIT  ), 0 );
        hv_store( ptr_hash, "UNITS_LEN", 9, newSVuv( param_info-> UNITS_LEN ), 0 );

        body_len -= PARAM_INFO_BLOCK_LEN;
        rec_body_point += PARAM_INFO_BLOCK_LEN;
        if( body_len > 0 ){
            if( param_info-> UNITS_LEN == 0 ){
                hv_store( ptr_hash, "UNITS", 5, newSVpv( "", 0 ), 0 );
            }else if( body_len > param_info-> UNITS_LEN ){
                hv_store( ptr_hash, "UNITS", 5, newSVpv( param_info->UNITS, param_info-> UNITS_LEN ), 0 );
            }else{
                croak( "no enough bytes for UNITS." );
            }

            body_len -= param_info-> UNITS_LEN;
            rec_body_point += param_info-> UNITS_LEN;
        }
    }else{
        body_len = 0;
    }
    
    for( int key_idx = 0; key_idx < 3; key_idx ++ ){
        if( body_len < CHAR_LEN ){
            break;
        }else{
            char* fmt_key = fmt_key_list[ key_idx ];
            int fmt_len = fetch_and_store_a_str( ptr_hash, fmt_key, 8, rec_body_point, body_len );
            body_len -= fmt_len;
            rec_body_point += fmt_len;
        }
    }

    if( body_len >= PARAM_SPEC_LEN ){
        float* lo_spec = rec_body_point;
        float* hi_spec = rec_body_point + sizeof( float );
        hv_store( ptr_hash, "LO_SPEC", 7, newSVnv( *lo_spec ), 0 );
        hv_store( ptr_hash, "HI_SPEC", 7, newSVnv( *hi_spec ), 0 );
    }

    return( newRV_noinc( (SV*) ptr_hash ) );
}


_C_CODE_

BEGIN{
    push @INC,"./";
}

my %REC_TYPE_HASH=(
    0=>{ 10=>'FAR',20=>'ATR', },
    1=>{ 10=>'MIR', 20=>'MRR', 30=>'PCR', 40=>'HBR', 50=>'SBR', 60=>'PMR', 62=>'PGR',63=>'PLR',70=>'RDR',80=>'SDR', },
    2=>{ 10=>'WIR', 20=>'WRR',30=>'WCR' },
    5=>{ 10=>'PIR', 20=>'PRR', },
    10=>{ 30=>'TSR', },
    15=>{ 10=>'PTR', 15=>'MPR', 20=>'FTR', },
    20=>{ 10=>'BPS', 20=>'EPS' },
    50=>{ 10=>'GDR', 30=>'DTR' },
);

has 'input_file' => (
    is=>'ro',
    isa=>sub{
        #confess "Input_file is necessary." unless defined $_[0];
        return 1 if not defined $_[0];
        confess "Input_file($_[0]) is not existed." unless -e $_[0];
    },
    required=>0,
    default=>undef,
    lazy=>1,
    after=>'set_input_file'
);

has 'gz_flag'=>(
    is=>'ro',
    isa=>sub{
        confess "gz_flag should only be 1 or 0." unless $_[0] ~~ [1,0];
    },
    default=>0,
);

has 'ignor_ext'=>(
    is=>'ro',
    isa=>sub{
        confess "ignor_ext flag should be 1 or 0." unless $_[0] ~~ [1,0];
    },
    default=>0,
);

has 'slurp_file' => (
    is      =>'ro',
    isa     => sub {
        confess "slurp_file flag should be 1 or 0." unless $_[0] ~~ [1,0];
    },
    default => 1,
);

sub set_input_file($self,$input_file){
    if(not (-e -f -r $input_file)){
        croak "Input file is not existed, or not a file.";
    }
    my $open_mode='<';
    if( ($self->ignor_ext ==0 and $input_file=~/\.gz$/) or $self->gz_flag){
        $open_mode.=':via(gzip)';
    }
    if( $self->slurp_file ){
        open my $i_o, '<', $input_file or croak "Fail to open input file".$input_file.": $!";
        binmode $i_o;
        read $i_o, my $whole_file_content, -s $input_file;
        close $i_o;
        open $self->{file_handle}, $open_mode,\$whole_file_content or croak "Fail to open input file".$input_file.": $!";
    }else{
        open $self->{file_handle}, $open_mode,$input_file or croak "Fail to open input file".$input_file.": $!";
    }
}



my $rec_template_hash={
        FAR=>{
            COLUMNS=>[qw(CPU_TYPE STDF_VER)],
            TEMPLATE=>'C C'
        },
        MIR=>{
            COLUMNS=>[qw(SETUP_T START_T STAT_NUM MODE_COD RTST_COD PROT_COD BURN_TIM CMOD_COD LOT_ID PART_TYP NODE_NAM 
                        TSTR_TYP JOB_NAM JOB_REV SBLOT_ID OPER_NAM EXEC_TYP EXEC_VER TEST_COD TST_TEMP USER_TXT AUX_FILE 
                        PKG_TYP FAMLY_ID DATE_COD FACIL_ID FLOOR_ID PROC_ID OPER_FRQ SPEC_NAM SPEC_VER FLOW_ID SETUP_ID 
                        DSGN_REV ENG_ID ROM_COD SERL_NUM SUPR_NAM)],
            TEMPLATE=>'L L C a1 a1 a1 S a1 (C/a)*'
        },
        PMR=>{
            COLUMNS=>[qw(PMR_INDX CHAN_TYP CHAN_NAM PHY_NAM LOG_NAM HEAD_NAM SITE_NUM)],
            TEMPLATE=>"S S C/a C/a C/a C C"
        },
        PTR=>{
            COLUMNS=>[qw(TEST_NUM HEAD_NUM SITE_NUM TEST_FLG PARM_FLG RESULT TEST_TXT ALARM_ID OPT_FLAG RES_SCAL LLM_SCAL 
            HLM_SCAL LO_LIMIT HI_LIMIT UNITS C_RESFMT C_LLMFMT C_HLMFMT LO_SPEC HI_SPEC)],
            TEMPLATE=>"L C C C C f C/a C/a C c c c f f C/a C/a C/a C/a f f"
        },
        HBR=>{
            COLUMNS=>[qw(HEAD_NUM SITE_NUM HBIN_NUM HBIN_CNT HBIN_PF HBIN_NAM)],
            TEMPLATE=>"C C S L a1 C/a"
        },
        SBR=>{
            COLUMNS=>[qw(HEAD_NUM SITE_NUM SBIN_NUM SBIN_CNT SBIN_PF SBIN_NAM)],
            TEMPLATE=>"C C S L a1 C/a"
        },
        PCR=>{
            COLUMNS=>[qw(HEAD_NUM SITE_NUM PART_CNT RTST_CNT ABRT_CNT GOOD_CNT FUNC_CNT)],
            TEMPLATE=>"C C L L L L L",
        },
        MRR=>{
            COLUMNS=>[qw(FINISH_T DISP_COD USR_DESC EXC_DESC)],
            TEMPLATE=>"L C (C/a)*" #8268ff5d20
        },
        WRR=>{
            COLUMNS=>[qw(HEAD_NUM SITE_GRP FINISH_T PART_CNT RTST_CNT ABRT_CNT GOOD_CNT FUNC_CNT WAFER_ID FABWF_ID FRAME_ID MASK_ID USR_DESC EXC_DESC)],
            TEMPLATE=>"C C L L L L L L (C/a)*"  
        },
        PRR=>{
            COLUMNS=>[qw(HEAD_NUM SITE_NUM PART_FLG NUM_TEST HARD_BIN SOFT_BIN X_COORD Y_COORD TEST_T PART_ID PART_TXT PART_FIX)],
            TEMPLATE=>"C C C S S S s s L (C/a)*"
        },
        DTR=>{
            COLUMNS=>[qw(TEXT_DAT)],
            TEMPLATE=>"C/a"
        },
        BPS=>{
            COLUMNS=>[qw(SEQ_NAME)],
            TEMPLATE=>"C/a"
        },
        WCR=>{
            COLUMNS=>[qw(WAFER_SIZ DIE_HT DIE_WID WF_UNITS WF_FLAT CENTER_X CENTER_Y POS_X POS_Y)],
            TEMPLATE=>"f f f C a1 s s a1 a1"
        },
        PIR=>{
            COLUMNS=>[qw(HAED_NUM SITE_NUM)],
            TEMPLATE=>"C C"
        },
        WIR=>{
            COLUMNS=>[qw(HEAD_NUM SITE_GRP START_T WAFER_ID)],
            TEMPLATE=>"C C L C/a"
        },
        TSR=>{
            COLUMNS=>[qw(HEAD_NUM SITE_NUM TEST_TYPE TEST_NUM EXEC_CNT FAL_CNT ALRM_CNT TEST_NAME SEQ_NAME TEST_LBL OPT_FLAG TEST_TIM TEST_MIN TEST_MAX TST_SUMS TST_SQRS)],
            TEMPLATE=>"C3 L4 (C/a)3 C f5"
        },
        ATR=>{
            COLUMNS=>[qw(MOD_TIM CMD_LINE)],
            TEMPLATE=>"L C/a",
        }
    };

my $rec_func_hash={
    FAR=>sub {my $self=shift;$self->get_rec_simple("FAR",$_[0])},
    MIR=>sub {my $self=shift;$self->get_rec_simple("MIR",$_[0])},
    SDR=>sub {my $self=shift;$self->get_rec_sdr($_[0])},
    PMR=>sub {my $self=shift;$self->get_rec_simple("PMR",$_[0])},
    FTR=>sub {my $self=shift;$self->get_rec_ftr($_[0])},
    PTR=>sub {
            my $self=shift;
            my $rec_hash = handle_ptr_c( $_[0] );
            # $rec_hash->{ OPT_FLAG } = STDF_Array->new(
            #         value_array=>[ $rec_hash->{ OPT_FLAG } ],
            #         type=>'bit',
            #         name=>'OPT_FLAG'
            #     );
            # $rec_hash->{ TEST_FLG } = STDF_Array->new(
            #         value_array=>[ $rec_hash->{ TEST_FLG } ],
            #         type=>'bit',
            #         name=>'TEST_FLG'
            #     );
            # $rec_hash->{ PARM_FLG } = STDF_Array->new(
            #         value_array=>[ $rec_hash->{ PARM_FLG } ],
            #         type=>'bit',
            #         name=>'PARM_FLG'
            #     );
            $rec_hash;
        },
    HBR=>sub {my $self=shift;$self->get_rec_simple("HBR",$_[0])},
    SBR=>sub {my $self=shift;$self->get_rec_simple("SBR",$_[0])},
    PCR=>sub {my $self=shift;$self->get_rec_simple("PCR",$_[0])},
    MRR=>sub {my $self=shift;$self->get_rec_simple("MRR",$_[0])},
    WRR=>sub {my $self=shift;$self->get_rec_simple("WRR",$_[0])},
    PRR=>sub {my $self=shift;$self->get_rec_simple("PRR",$_[0])},
    DTR=>sub {my $self=shift;$self->get_rec_simple("DTR",$_[0])},
    BPS=>sub {my $self=shift;$self->get_rec_simple("BPS",$_[0])},
    WCR=>sub {my $self=shift;$self->get_rec_simple("WCR",$_[0])},
    PIR=>sub {my $self=shift;$self->get_rec_simple("PIR",$_[0])},
    WIR=>sub {my $self=shift;$self->get_rec_simple("WIR",$_[0])},
    PGR=>sub {my $self=shift;$self->get_rec_pgr($_[0])},
    PLR=>sub {my $self=shift;$self->get_rec_plr($_[0])},
    MPR=>sub {my $self=shift;$self->get_rec_mpr($_[0])},
    TSR=>sub {my $self=shift;$self->get_rec_simple("TSR",$_[0])},
    ATR=>sub {my $self=shift;$self->get_rec_simple("ATR",$_[0])},
    EPS=>sub { {'TXT'=>'END OF A TEST.'} },
};

sub BUILD{
    my $self=shift;
    if(defined $self->input_file){
        $self->set_input_file($self->input_file);
    }
}

sub get_rec_header($self){
    if(not exists $self->{file_handle}){
        confess "Call get_rec_header before specific a input file"
    }
    my $fh=$self->{file_handle};
    if(eof $fh){
        return;
    }
    read $fh,my $rec_header,4;
    my ($REC_LEN,$REC_TYPE,$REC_SUBTYPE) = unpack "SCC",$rec_header;
    
    return {
        REC_LEN=>$REC_LEN,
        REC_TYPE=>$REC_TYPE_HASH{$REC_TYPE}{$REC_SUBTYPE} // 'NotDefined'
    }
}

sub get_rec_body($self,$rec_header){
    if(not exists $self->{file_handle}){
        confess "Call get_rec_body before specific a input file"
    }

    my $fh=$self->{file_handle};
    if(eof $fh){
        return;
    }
    read $fh,my $rec_body,$rec_header->{'REC_LEN'};
    return {
        REC_BODY=>$rec_body,
        REC_TYPE=>$rec_header->{'REC_TYPE'},
        REC_LEN=>$rec_header->{'REC_LEN'}
    };
}

sub get_rec_string($self){
    my $fh=$self->{file_handle};
    
    read $fh, my $str_len,1;
    $str_len=unpack "C",$str_len;
    if($str_len==0){
        return undef;
    }
    read($fh, my $str, $str_len);
    return($str);
}

sub get_rec_simple($self,$REC_TYPE,$rec_body=undef){
    if(not exists $rec_template_hash->{$REC_TYPE}){
        confess [caller(0)]->[3]."() could not handle REC_TYPE=$REC_TYPE. It's complex or not valid.";
    }
    my %rec_hash=();
    eval { @rec_hash{ @{ $rec_template_hash->{$REC_TYPE}{'COLUMNS'} } }= unpack $rec_template_hash->{$REC_TYPE}{'TEMPLATE'}, $rec_body};
    return do{
        if($@){
            carp $@;
            {
                ERR_TXT=>$@,
                MID_RESULT=>Dumper(\%rec_hash),
                REC_BODY=>unpack "H*",$rec_body
            }
        }
        else{\%rec_hash}
    };
}

sub get_rec_sdr($self,$rec_body){
    my %rec_hash=();
    
    @rec_hash{ qw(HEAD_NUM SITE_GRP) }=unpack "C C", substr $rec_body,0,2;
    my ($SITE_CNT,@site_numbers)=unpack 'C X C/C',substr $rec_body,2;
    @rec_hash{qw(SITE_CNT SITE_NUM)}=(
        $SITE_CNT,
        STDF_Array->new(
            value_array=>\@site_numbers,
            type=>'int',
            name=>'SITE_NUM'
            )
        );
    @rec_hash{ qw(HAND_TYP HAND_ID CARD_TYP CARD_ID LOAD_TYP LOAD_ID DIB_TYP DIB_ID CABL_TYP CABL_ID CONT_TYP CONT_ID LASR_TYP LASR_ID EXTR_TYP EXTR_ID) }=
        unpack 'C/a'x16, substr $rec_body,2+$SITE_CNT+1;
    return \%rec_hash;
}

sub get_rec_pgr($self,$rec_body){
    my ($GRP_INDX,$GRP_NAM,$INDX_CNT,@PMR_INDX)=unpack "S C/a S X2 S/S", $rec_body;
    return {
        GRP_INDX=>$GRP_INDX,
        GRP_NAM=>$GRP_NAM,
        INDX_CNT=>$INDX_CNT,
        PMR_INDX=>STDF_Array->new(
            value_array=>\@PMR_INDX,
            type=>'int',
            name=>'PMR_INDX'
        )
    };
}

sub get_rec_plr($self,$rec_body){
    my $GRP_CNT=unpack "S",$rec_body;
    my (@GRP_INDX,@GRP_MODE,@GRP_RADX,@PGM_CHAR,@RTN_CHAR,@PGM_CHAL,@RTN_CHAL);
    my @range=0..$GRP_CNT-1;
    my $unpack_temp="S$GRP_CNT S$GRP_CNT C$GRP_CNT (C/a)$GRP_CNT (C/a)$GRP_CNT (C/a)$GRP_CNT (C/a)$GRP_CNT";
    #die $unpack_temp;
    (@GRP_INDX[@range],@GRP_MODE[@range],@GRP_RADX[@range],@PGM_CHAR[@range],@RTN_CHAR[@range],@PGM_CHAL[@range],@RTN_CHAL[@range])=
        unpack $unpack_temp, substr $rec_body,1;
    return {
        GRP_CNT=>$GRP_CNT,
        GRP_INDX=>STDF_Array->new(value_array=>\@GRP_INDX,type=>'int',name=>'GRP_INDX'),
        GRP_MODE=>STDF_Array->new(value_array=>\@GRP_MODE,type=>'int',name=>'GRP_MODE'),
        GRP_RADX=>STDF_Array->new(value_array=>\@GRP_RADX,type=>'int',name=>'GRP_RADX'),
        PGM_CHAR=>STDF_Array->new(value_array=>\@PGM_CHAR,type=>'char',name=>'PGM_CHAR'),
        RTN_CHAR=>STDF_Array->new(value_array=>\@RTN_CHAR,type=>'char',name=>'RTN_CHAR'),
        PGM_CHAL=>STDF_Array->new(value_array=>\@PGM_CHAL,type=>'char',name=>'PGM_CHAL'),
        RTN_CHAL=>STDF_Array->new(value_array=>\@RTN_CHAL,type=>'char',name=>'RTN_CHAL'),
    };
}

sub get_rec_mpr( $self, $rec_body ){
    my $mpr_hash_ref = {};
    @$mpr_hash_ref{ qw( 
        TEST_NUM HEAD_NUM SITE_NUM
        TEST_FLG PARM_FLG RTN_ICNT
        RSLT_CNT 
        ) } = unpack 'L C C C C S S', $rec_body;
    $rec_body = substr $rec_body, 4 + 1 + 1 + 1 + 1 + 2 + 2 ;
    # my $next_pattern = "C$mpr_hash_ref->{RTN_ICNT} f$mpr_hash_ref->{RSLT_CNT} C/a C/a C C C C f f f f S$mpr_hash_ref->{RTN_ICNT} C/a C/a C/a C/a C/a f f";

    # for RTN_STAT
    if( $mpr_hash_ref->{ RTN_ICNT } > 0 ){
        my $nibble_byte_count = POSIX::ceil( $mpr_hash_ref->{ RTN_ICNT } / 2 );
        $mpr_hash_ref->{ RTN_STAT } = [
            unpack "C$nibble_byte_count", $rec_body
        ];
        $rec_body = substr $rec_body, 1 * $nibble_byte_count;
    }else{
        $mpr_hash_ref->{ RTN_STAT } = [];
    }

    $mpr_hash_ref->{ RTN_STAT } = STDF_Array->new(value_array=>$mpr_hash_ref->{ RTN_STAT },type=>'nibble',name=>'RTN_STAT');

    # for RTN_RSLT
    if( $mpr_hash_ref->{ RSLT_CNT } > 0 ){
        $mpr_hash_ref->{ RTN_RSLT } = [
            unpack "f$mpr_hash_ref->{RSLT_CNT}", $rec_body
        ];
        $rec_body = substr $rec_body, 4 * $mpr_hash_ref->{RSLT_CNT};
    }else{
        $mpr_hash_ref->{ RTN_RSLT } = [];
    }

    $mpr_hash_ref->{ RTN_RSLT } = STDF_Array->new(value_array=>$mpr_hash_ref->{ RTN_RSLT },type=>'real',name=>'RTN_RSLT');

    @$mpr_hash_ref{ qw( 
        TEST_TXT ALARM_ID OPT_FLAG
        RES_SCAL LLM_SCAL HLM_SCAL
        LO_LIMIT HI_LIMIT START_IN
        INCR_IN 
        ) } = unpack "C/a C/a C C C C f f f f", $rec_body;
    $rec_body = substr $rec_body, 
                        ( length( $mpr_hash_ref->{ TEST_TXT } ) * 1 + 1 ) +
                        ( length( $mpr_hash_ref->{ ALARM_ID } ) * 1 + 1 ) + 
                        1 + 1 + 1 + 4 + 4 + 4 + 4;
    # for RTN_INDX
    if( $mpr_hash_ref->{ RTN_ICNT } > 0 ){
        $mpr_hash_ref->{ RTN_INDX } = [
            unpack "S$mpr_hash_ref->{RTN_ICNT}", $rec_body
        ];
        $rec_body = substr $rec_body, 2 * $mpr_hash_ref->{RTN_ICNT};
    }else{
        $mpr_hash_ref->{ RTN_INDX } = [];
    }

    $mpr_hash_ref->{ RTN_INDX } = STDF_Array->new(value_array=>$mpr_hash_ref->{ RTN_INDX },type=>'int',name=>'RTN_INDX');

    @$mpr_hash_ref{ qw(
        UNITS    UNITS_IN C_RESFMT
        C_LLMFMT C_HLMFMT LO_SPEC  HI_SPEC
        ) } = unpack "C/a C/a C/a C/a C/a f f", $rec_body;

    # $mpr_hash_ref->{ TEST_FLG } = STDF_Array->new(value_array=>[ $mpr_hash_ref->{ TEST_FLG } ],type=>'bit',name=>'TEST_FLG');
    # $mpr_hash_ref->{ PARM_FLG } = STDF_Array->new(value_array=>[ $mpr_hash_ref->{ PARM_FLG } ],type=>'bit',name=>'PARM_FLG');
    # $mpr_hash_ref->{ OPT_FLAG } = STDF_Array->new(value_array=>[ $mpr_hash_ref->{ OPT_FLAG } ],type=>'bit',name=>'OPT_FLAG');

    return $mpr_hash_ref;
}

sub get_rec_ftr($self,$rec_body){
    my %ftr_hash=();
    @ftr_hash{qw(TEST_NUM HEAD_NUM SITE_NUM TEST_FLG OPT_FLAG CYCL_CNT REL_VADR REPT_CNT NUM_FAIL XFAIL_AD YFAIL_AD VECT_OFF RTN_ICNT PGM_ICNT)}=
        unpack "L C4 L4 l2 s S2", $rec_body;
    my ($cnt_j,$cnt_k)=@ftr_hash{'RTN_ICNT','PGM_ICNT'};
    my $nibble_cnt_j = POSIX::ceil( $cnt_j / 2 );
    my $nibble_cnt_k = POSIX::ceil( $cnt_k / 2 );
    my (@RTN_INDX, @RTN_STAT,@PGM_INDX,@PGM_STAT,
        @FAIL_BIN, $VECT_NAM, $TIME_SET, $OP_CODE, $TEST_TXT, 
        $ALARM_ID, $PROG_TXT, $RSLT_TXT, $PATG_NUM, $SPIN_MAP);

    $rec_body=substr $rec_body,4+1*4+4*6+2*3;
    @RTN_INDX = ();
    @RTN_STAT = ();
    @PGM_INDX = ();
    @PGM_STAT = ();
    ( @RTN_INDX[0..$cnt_j-1],@RTN_STAT[0..$nibble_cnt_j-1],@PGM_INDX[0..$cnt_k-1],@PGM_STAT[0..$nibble_cnt_k-1] ) = 
                                    unpack "S$cnt_j C$nibble_cnt_j S$cnt_k C$nibble_cnt_k",$rec_body;
    $rec_body = substr $rec_body, $cnt_j * 2 + $nibble_cnt_j + $cnt_k * 2 + $nibble_cnt_k;
    my $fail_bin_byte_count = POSIX::ceil( unpack( "S", $rec_body ) / 8 );
    $rec_body = substr $rec_body, 2;
    @FAIL_BIN = unpack "C$fail_bin_byte_count",$rec_body;
    $rec_body = substr $rec_body, $fail_bin_byte_count;
    ( $VECT_NAM, $TIME_SET, $OP_CODE, $TEST_TXT, $ALARM_ID, $PROG_TXT, $RSLT_TXT, $PATG_NUM, $SPIN_MAP ) = unpack "(C/a)7 C C/S",$rec_body;
    # say join ',', unpack "S$cnt_j c$cnt_j S$cnt_k c$cnt_k C/S C/a C C C a20",$rec_body;
# )=unpack "S$cnt_j c$cnt_j S$cnt_k c$cnt_k S/a (C/a)7 C C/S",$rec_body;
    @ftr_hash{qw(RTN_INDX RTN_STAT PGM_INDX PGM_STAT
        FAIL_PIN VECT_NAM TIME_SET OP_CODE TEST_TXT 
        ALARM_ID PROG_TXT RSLT_TXT PATG_NUM SPIN_MAP
    )}=(
        # STDF_Array->new(value_array=>\@RTN_INDX,name=>'RTN_INDX',type=>'int'),
        # STDF_Array->new(value_array=>\@RTN_STAT,name=>'RTN_STAT',type=>'nibble'),
        # STDF_Array->new(value_array=>\@PGM_INDX,name=>'PGM_INDX',type=>'int'),
        # STDF_Array->new(value_array=>\@PGM_STAT,name=>'PGM_STAT',type=>'nibble'),
        # STDF_Array->new(value_array=>\@FAIL_BIN,name=>'FAIL_BIN',type=>'int'),
        \@RTN_INDX,
        \@RTN_STAT,
        \@PGM_INDX,
        \@PGM_STAT,
        \@FAIL_BIN,
        $VECT_NAM, $TIME_SET, $OP_CODE, $TEST_TXT, 
        $ALARM_ID, $PROG_TXT, $RSLT_TXT, $PATG_NUM, $SPIN_MAP
    );

    return \%ftr_hash;
}


sub get_record($self,$rec_header=undef,$rec_body=undef){
    if(not exists $self->{file_handle} and not(defined $rec_header and defined $rec_body)) {
        confess "Call get_record before specific a input file";
    }
    if(exists $self->{file_handle} and eof $self->{file_handle}){
        if(not (defined $rec_header and defined $rec_body)){
            return;
        }
    }
    if(not defined $rec_header){
        $rec_header=$self->get_rec_header();
    }
    if(not defined $rec_body){
        my $rec_body_return = $self->get_rec_body($rec_header);
        if( not $rec_body_return ){
            return;
        }
        $rec_body = $rec_body_return->{'REC_BODY'};
    }

    $rec_body = $rec_body . "\x00\x00\x00\x00\x00\x00\x00\x00\x00" x 128;

    if($rec_header->{'REC_LEN'}<=0 and $rec_header->{'REC_TYPE'} ne "EPS"){
        confess "REC_LEN in record header should larger than zero. But we got ".$rec_header->{'REC_LEN'};
    }

    if(not defined $rec_func_hash->{ $rec_header->{'REC_TYPE'} }){
        carp "REC_TYPE ".$rec_header->{'REC_TYPE'}." is not be handled by program in current version."
    }

    my $func=$rec_func_hash->{ $rec_header->{'REC_TYPE'} } // sub {$self->get_rec_body($rec_header)};

    return {
        header=>$rec_header,
        body=>$func->($self,$rec_body),
        };
}



1;